perm filename SCARLE.F4[SAB,LCS]1 blob
sn#349445 filedate 1978-04-15 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 REAL NA
C00003 ENDMK
Cā;
REAL NA
DIMENSION IBUF(5000)
COMMON /FAC/JFAC,KFAC
TYPE 1
ACCEPT 2,JFAC,KFAC
1 FORMAT(' TYPE X FACTOR AND Y FACTOR '$)
2 FORMAT(2I)
CALL PLOTS(IBUF,5000,1)
CALL PLOT(15.,14.75,-3)
IF(JFAC.EQ.0)JFAC=100
IF(KFAC.EQ.0)KFAC=100
A=5.
B=5.
ANGLE=0.
10 CALL ELLIPS(A,B,ANGLE)
20 DO 50 M=1,40
NA=A
NA=(1.-.025*M)*NA
ANGLE=ANGLE+2.25
30 CALL ELLIPS(NA,B,ANGLE)
50 CONTINUE
ANGLE=0.
DO 60 N=1,40
NA=A
NA=(1.-.025*N)*NA
ANGLE=ANGLE-2.25
CALL ELLIPS(NA,B,ANGLE)
60 CONTINUE
A=A-1.
CALL PLOT(0.,-30.,-3)
CALL PLOT(0.,0.,999)
STOP
END